home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1997 July: Mac OS SDK / Dev.CD Jul 97 SDK2.toast / Development Kits (Disc 2) / ScriptX / Code Samples / untested / tcpip / browser / html.sx < prev    next >
Encoding:
Text File  |  1996-05-21  |  11.0 KB  |  462 lines  |  [TEXT/ttxt]
  1. --<<<
  2.  
  3. in module HTMLImplementation
  4.  
  5. class HTMLDisplayer ()
  6. instance variables
  7.     stream
  8.     pres
  9.     txt
  10.     targetText
  11.     currentStyle
  12.     styleStack
  13.     url
  14.     anchorStart
  15.     anchorURL
  16.     callback
  17.     state
  18.     title
  19.     startX
  20.     startY
  21.     myParentGroup
  22.     myBoundary
  23.     browser
  24. end
  25.  
  26. -- Perhaps HTMLStream should define all of these automatically.
  27.  
  28. global HTML_A := 0
  29. global HTML_ABBREV := 1
  30. global HTML_ABSTRACT := 2
  31. global HTML_ACRONYM := 3
  32. global HTML_ADDED := 4
  33. global HTML_ADDRESS := 5
  34. global HTML_ARG := 6
  35. global HTML_B := 7
  36. global HTML_BASE := 8
  37. global HTML_BLOCKQUOTE := 9
  38. global HTML_BODY := 10
  39. global HTML_BOX := 11
  40. global HTML_BR := 12
  41. global HTML_BYLINE := 13
  42. global HTML_CAPTION := 14
  43. global HTML_CHANGED := 15
  44. global HTML_CITE := 16
  45. global HTML_CMD := 17
  46. global HTML_CODE := 18
  47. global HTML_COMMENT := 19
  48. global HTML_DD := 20
  49. global HTML_DFN := 21
  50. global HTML_DIR := 22
  51. global HTML_DL := 23
  52. global HTML_DT := 24
  53. global HTML_EM := 25
  54. global HTML_FIG := 26
  55. global HTML_FOOTNOTE := 27
  56. global HTML_FORM := 28
  57. global HTML_H1 := 29
  58. global HTML_H2 := 30
  59. global HTML_H3 := 31
  60. global HTML_H4 := 32
  61. global HTML_H5 := 33
  62. global HTML_H6 := 34
  63. global HTML_H7 := 35
  64. global HTML_HEAD := 36
  65. global HTML_HR := 37
  66. global HTML_HTML := 38
  67. global HTML_HTMLPLUS := 39
  68. global HTML_I := 40
  69. global HTML_IMAGE := 41
  70. global HTML_IMG := 42
  71. global HTML_INPUT := 43
  72. global HTML_ISINDEX := 44
  73. global HTML_KBD := 45
  74. global HTML_L := 46
  75. global HTML_LI := 47
  76. global HTML_LINK := 48
  77. global HTML_LISTING := 49
  78. global HTML_LIT := 50
  79. global HTML_MARGIN := 51
  80. global HTML_MATH := 52
  81. global HTML_MENU := 53
  82. global HTML_NEXTID := 54
  83. global HTML_NOTE := 55
  84. global HTML_OL := 56
  85. global HTML_OPTION := 57
  86. global HTML_OVER := 58
  87. global HTML_P := 59
  88. global HTML_PERSON := 60
  89. global HTML_PLAINTEXT := 61
  90. global HTML_PRE := 62
  91. global HTML_Q := 63
  92. global HTML_QUOTE := 64
  93. global HTML_RENDER := 65
  94. global HTML_REMOVED := 66
  95. global HTML_S := 67
  96. global HTML_SAMP := 68
  97. global HTML_SELECT := 69
  98. global HTML_STRONG := 70
  99. global HTML_SUB := 71
  100. global HTML_SUP := 72
  101. global HTML_TAB := 73
  102. global HTML_TABLE := 74
  103. global HTML_TD := 75
  104. global HTML_TEXTAREA := 76
  105. global HTML_TH := 77
  106. global HTML_TITLE := 78
  107. global HTML_TR := 79
  108. global HTML_TT := 80
  109. global HTML_U := 81
  110. global HTML_UL := 82
  111. global HTML_VAR := 83
  112. global HTML_XMP := 84
  113. global HTML_XSCRIPTX := 85
  114. global HTML_LAST := 86
  115.  
  116. global defaultStyle := #(@size:12, @underline:0, @weight:@regular, \
  117.              @alignment:@fill, @paraindent:4, @indent:4, @indentfromend:4)
  118.  
  119. method init self {object HTMLDisplayer} #rest args \
  120.             #key url: callback: boundary: parent: browser: -> (
  121.     apply nextmethod self args
  122.     self.startX := 0
  123.     self.startY := 0
  124.     self.myParentGroup := parent
  125.     self.myBoundary := boundary
  126.  
  127.     self.currentStyle := new KeyedLinkedList
  128.     addMany self.currentStyle defaultStyle
  129.     self.styleStack := new LinkedList
  130.  
  131.     startTextPresenter self
  132.  
  133.     self.url := url
  134.     self.callback := callback
  135.     self.state := @normal
  136.     self.title := new String
  137.     self.browser := browser
  138.     self.stream := new HtmlStream \
  139.                             startElement: (displayer element #rest args -> apply startelement self element args) \
  140.                             endElement: (displayer element -> endElement self element) \
  141.                             putCharacter: (displayer ch -> putcharacter self ch)
  142. )
  143.  
  144. method startElement self {object HTMLDisplayer} element #rest args -> (
  145.     local fun := gethandler element
  146.     if fun != undefined do apply fun self  element true args
  147. )
  148.     
  149. method endElement self {object HTMLDisplayer} element -> (
  150.     local fun := gethandler element
  151.     if fun != undefined do fun self element false
  152. )
  153.  
  154. method startTextPresenter self {object HTMLDisplayer} -> (
  155.     self.txt := new Text
  156.     self.targetText := new Text
  157.     self.pres := new TextPresenter target: self.targetText \
  158.                 boundary: (copy self.myBoundary)
  159.     append self.myParentGroup self.pres
  160.     self.pres.x := self.startX
  161.     self.pres.y := self.startY
  162.     foreachbinding self.currentStyle \
  163.         (key value arg -> setattr self.txt key (size self.txt) value) \
  164.          undefined
  165. )
  166.  
  167. method finishTextPresenter self {object HTMLDisplayer} -> (
  168.     if self.pres != undefined do (
  169.        flushText self
  170.        self.startY := self.startY + self.pres.height
  171.        -- Nice to do this with width also
  172.       if (size self.pres.target = 0) do (
  173.           deleteOne self.myParentGroup self.pres
  174.       )
  175.        self.pres := undefined
  176.     )
  177. )
  178.  
  179. method putCharacter self {object HTMLDisplayer} character -> (
  180.     if character == 13 do return
  181.     case self.state of
  182.         @title : 
  183.             append self.title character
  184.         @verbatim:
  185.             append self.txt character
  186.         otherwise : (
  187.               if character == 10 do character := 32
  188.              append self.txt character
  189.             )
  190.     end
  191.     local n := size self.txt
  192.     if (n > 0 and (mod n 10000) = 0) do
  193.         flushText self
  194. )
  195.  
  196. function foo file -> (
  197.     local s := getstream thestartdir file @readable
  198.     local x := new htmldisplayer url: (new url string: ("http://www.kaleida.com/" + file))
  199.     s | x
  200.     plug s
  201.     x
  202. )
  203.  
  204. function crash -> (
  205.     local y := new htmldisplayer
  206.     local s := "<H2>The Kaleida Media Player</H2>"
  207.     writestring y s
  208.     writestring y s
  209. )
  210.  
  211. -- Element handlers
  212. -- function self element startp present values ->
  213.  
  214. global elementhandlers := new Array
  215. for i := 0 to HTML_LAST do append elementHandlers undefined
  216. function gethandler element ->     elementHandlers[element + 1]
  217. function sethandler element fun -> elementHandlers[element + 1] := fun
  218.  
  219.  
  220. -- This does not have to be done. The TextPresenter seems to update itself anyway
  221.  
  222. method noteChanged self {object HTMLDisplayer} -> (
  223.     self.pres.changed := true
  224. )
  225.  
  226. global headerStyles := #(HTML_H1:#(@weight:@bold, @size:18),
  227.              HTML_H2:#(@weight:@bold, @size:14))
  228.  
  229. function handleHTML_H self element start #rest args -> (
  230.     if start then (
  231.         newPara self
  232.         pushStyle self
  233.         local style := headerStyles[element]
  234.         if style == empty then (
  235.             setStyle self #(@weight:@bold)
  236.         ) else (
  237.             setStyle self style
  238.         )
  239.     ) else (
  240.     
  241.          popStyle self
  242.         newPara self
  243.     )
  244. )
  245.  
  246. sethandler HTML_H1 handleHTML_H
  247. sethandler HTML_H2 handleHTML_H
  248. sethandler HTML_H3 handleHTML_H
  249. sethandler HTML_H4 handleHTML_H
  250. sethandler HTML_H5 handleHTML_H
  251. sethandler HTML_H6 handleHTML_H
  252. sethandler HTML_H7 handleHTML_H
  253.  
  254. function handleHTML_P self element start #rest args -> (
  255.     newPara self
  256. )
  257.  
  258. sethandler HTML_P handleHTML_P
  259.  
  260. -- This is a bit inefficient!!!
  261.  
  262. method pushStyle self {object HTMLDisplayer} -> (
  263.     prepend self.styleStack (new keyedlinkedlist)
  264. )
  265.  
  266. method popStyle self {object HTMLDisplayer} -> (
  267.     setStyle self self.styleStack[1]
  268.     pop self.styleStack
  269. )
  270.  
  271. method setStyleAttr self {object HTMLDisplayer} key idx value -> (
  272.     local currentValue := self.currentStyle[key]
  273.     for safe in self.styleStack do
  274.       if (safe[key] = empty) do add safe key currentValue
  275.     self.currentStyle[key] := value
  276.     setattr self.txt key idx value
  277. )
  278.  
  279. method setStyle self {object HTMLDisplayer} style -> (
  280.     local idx := (size self.txt)
  281.     foreachbinding style (key value arg -> setStyleAttr self key idx value) \
  282.          undefined
  283. )
  284.  
  285. global endOfLine := 13
  286.  
  287. method newPara self {object HTMLDisplayer} -> (
  288.     append self.txt endOfLine
  289.     append self.txt endOfLine
  290. )
  291.  
  292. function handleNewPara self element start #rest args -> (
  293.     newPara self
  294. )
  295.  
  296. sethandler HTML_LI handleNewPara
  297. sethandler HTML_DL handleNewPara
  298. sethandler HTML_DT handleNewPara
  299. sethandler HTML_DD handleNewPara
  300.  
  301. function handle_HR self element start #rest args -> (
  302.       finishTextPresenter self
  303.       local p := new TwoDShape \
  304.                        fill: blackbrush \
  305.                        stroke: blackbrush \
  306.                        boundary: (new line x2: self.myBoundary.width y2: 0)
  307.   
  308.        p.x := self.startX
  309.        p.y := self.startY
  310.        self.startY := self.startY + 3
  311.        append self.myParentGroup p
  312.        startTextPresenter self
  313. )
  314.  
  315. sethandler HTML_HR handle_HR
  316.  
  317. function setStyleHandler element style -> (
  318.     sethandler element \
  319.     (self element start #rest args -> (
  320.     if start then (
  321.         pushStyle self
  322.         setStyle self style
  323.     ) else (
  324.        popStyle self
  325.      )
  326.     ))
  327. )
  328.  
  329. setStyleHandler HTML_B #(@weight:@bold)
  330.  
  331. function handleHTML_A self element start #rest args #key href: -> (
  332.       if start then (
  333.         if (href != unsupplied) do (
  334.         self.anchorStart := size self.txt
  335.  
  336.         if (self.url != undefined) do (
  337.               if (not (isaKindof href url)) do
  338.             href := new url string: href
  339.           self.anchorURL := merge href self.url
  340.         )
  341.  
  342.         pushStyle self
  343.         setStyle self #(@underline:2)
  344.         )
  345.       ) else (
  346.         if (self.anchorStart != undefined) do (
  347.             local anchorend := size self.txt
  348.             local destinationurl := self.anchorurl
  349.             popstyle self
  350.             setattrfromto self.txt @action self.anchorstart anchorend \
  351.                       (#rest args -> gotourl self destinationurl )
  352.             self.anchorstart := undefined
  353.                         self.anchorURL := undefined
  354.         )
  355.       )
  356. )
  357.  
  358. sethandler HTML_A handleHTML_A
  359.  
  360. function handleHTML_TITLE self element start #rest args #key href: -> (
  361.     self.state := if start then @title else @normal
  362. )
  363.  
  364. function handleHTML_PRE self element start #rest args -> (
  365.     if start then (
  366.         pushStyle self
  367.         self.state := @verbatim
  368.     ) else (
  369.         popStyle self
  370.         self.state := @normal
  371.         setStyle self #(@alignment:@tty)
  372.     )
  373. )
  374.  
  375. sethandler HTML_TITLE handleHTML_TITLE
  376. sethandler HTML_PRE handleHTML_PRE
  377.  
  378. ---
  379.  
  380. method gotoURL self {object htmldisplayer} url -> (
  381.     self.callback self url
  382. )
  383.  
  384. method clear self {object htmldisplayer} -> (
  385.     emptyOut self.txt
  386.     emptyOut self.targetText
  387. )
  388.  
  389.  
  390. method plug self {object htmldisplayer} -> (
  391.     plug self.stream
  392.     finishTextPresenter self
  393. )
  394.  
  395. method flushText self {object htmldisplayer} -> (
  396.     ht := self
  397.     insertAt self.targettext self.txt (size self.targetText)
  398.     emptyOut self.txt
  399.     if (size self.pres.target > 0) do (
  400.         local top := self.pres.presentedby
  401.         repeat until top.presentedby = undefined do top := top.presentedby
  402.         setContext self.pres top.displaysurface top.bbox
  403.         self.pres.height := calculate self.pres @width self.pres.width
  404.         noteChanged self
  405.     )
  406. )
  407.  
  408. --
  409.  
  410. function handleHTML_XSCRIPTX self element start #rest args #key width: height: src: -> (
  411.     finishTextPresenter self
  412.     width := width as integer
  413.     height := height as integer
  414.     local p := new TwoDMultiPresenter boundary: (new Rect x2: width y2: height)
  415.     p.x := self.startX
  416.     p.y := self.startY
  417.     append self.myParentGroup p
  418.  
  419.     -- Error
  420.     local tc := openContainerFromURL (merge (new url string: src) self.url)
  421.  
  422.     new tc[1] parent: p browser: self.browser tc: tc
  423.  
  424.     self.startY := self.startY + height
  425.     startTextPresenter self
  426. )
  427.  
  428. sethandler HTML_XSCRIPTX handleHTML_XSCRIPTX
  429.  
  430. print "image support is commented out"
  431.  
  432. function handleHTML_IMG self element start #rest args #key width: height: src: -> (
  433.     -- This html parser does not support width/height!
  434.     -- We should not download the whole thing if we do not know the image type
  435.         /*
  436.     local stuff := getURLToTempFile (merge (new url string: src) self.url)
  437.     local file := stuff[2]
  438.     local type := getone stuff[1] ("content-type" as string)
  439.     if (type = ("image/gif" as string)) then (
  440.         finishTextPresenter self
  441.         print src
  442.         local myStream := getStream theTempDir file @Readable
  443.         local myBitmap := importMedia theImportExportEngine myStream @image @GIF @bitmap
  444.         print #("done", src)
  445.         local bp := new TwoDShape target:myBitmap fill:blackBrush -- stroke:blackBrush
  446.         bp.x := self.startX
  447.         bp.y := self.startY
  448.         append self.myParentGroup bp
  449.         self.startY := self.startY + bp.height
  450.         plug myStream
  451.         startTextPresenter self
  452.     ) else (
  453.         print #("unknown image type", type)
  454.     )
  455.     
  456.         */
  457. )
  458.  
  459. sethandler HTML_IMG handleHTML_IMG
  460.  
  461. -->>>
  462.